home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue47 / Clinic / ActiveX / SHDOCVW.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1999-01-14  |  14.8 KB  |  419 lines
  1. unit SHDOCVW;
  2.  
  3. { Conversion log:
  4.   Property TWebBrowser.Type renamed to Type_: Identifier is a reserved word }
  5.  
  6. interface
  7.  
  8. uses Ole2, OleCtl, Classes, Graphics, OleCtrls;
  9.  
  10. const
  11.  
  12. { CommandStateChangeConstants }
  13.  
  14.   CSC_UPDATECOMMANDS = -1;
  15.   CSC_NAVIGATEFORWARD = 1;
  16.   CSC_NAVIGATEBACK = 2;
  17.  
  18. { OLECMDID }
  19.  
  20.   OLECMDID_OPEN = 1;
  21.   OLECMDID_NEW = 2;
  22.   OLECMDID_SAVE = 3;
  23.   OLECMDID_SAVEAS = 4;
  24.   OLECMDID_SAVECOPYAS = 5;
  25.   OLECMDID_PRINT = 6;
  26.   OLECMDID_PRINTPREVIEW = 7;
  27.   OLECMDID_PAGESETUP = 8;
  28.   OLECMDID_SPELL = 9;
  29.   OLECMDID_PROPERTIES = 10;
  30.   OLECMDID_CUT = 11;
  31.   OLECMDID_COPY = 12;
  32.   OLECMDID_PASTE = 13;
  33.   OLECMDID_PASTESPECIAL = 14;
  34.   OLECMDID_UNDO = 15;
  35.   OLECMDID_REDO = 16;
  36.   OLECMDID_SELECTALL = 17;
  37.   OLECMDID_CLEARSELECTION = 18;
  38.   OLECMDID_ZOOM = 19;
  39.   OLECMDID_GETZOOMRANGE = 20;
  40.   OLECMDID_UPDATECOMMANDS = 21;
  41.   OLECMDID_REFRESH = 22;
  42.   OLECMDID_STOP = 23;
  43.   OLECMDID_HIDETOOLBARS = 24;
  44.   OLECMDID_SETPROGRESSMAX = 25;
  45.   OLECMDID_SETPROGRESSPOS = 26;
  46.   OLECMDID_SETPROGRESSTEXT = 27;
  47.   OLECMDID_SETTITLE = 28;
  48.   OLECMDID_SETDOWNLOADSTATE = 29;
  49.   OLECMDID_STOPDOWNLOAD = 30;
  50.   OLECMDID_ONTOOLBARACTIVATED = 31;
  51.   OLECMDID_FIND = 32;
  52.   OLECMDID_DELETE = 33;
  53.   OLECMDID_HTTPEQUIV = 34;
  54.   OLECMDID_HTTPEQUIV_DONE = 35;
  55.   OLECMDID_ENABLE_INTERACTION = 36;
  56.   OLECMDID_ONUNLOAD = 37;
  57.   OLECMDID_PROPERTYBAG2 = 38;
  58.   OLECMDID_PREREFRESH = 39;
  59.  
  60. { OLECMDF }
  61.  
  62.   OLECMDF_SUPPORTED = 1;
  63.   OLECMDF_ENABLED = 2;
  64.   OLECMDF_LATCHED = 4;
  65.   OLECMDF_NINCHED = 8;
  66.  
  67. { OLECMDEXECOPT }
  68.  
  69.   OLECMDEXECOPT_DODEFAULT = 0;
  70.   OLECMDEXECOPT_PROMPTUSER = 1;
  71.   OLECMDEXECOPT_DONTPROMPTUSER = 2;
  72.   OLECMDEXECOPT_SHOWHELP = 3;
  73.  
  74. { tagREADYSTATE }
  75.  
  76.   READYSTATE_UNINITIALIZED = 0;
  77.   READYSTATE_LOADING = 1;
  78.   READYSTATE_LOADED = 2;
  79.   READYSTATE_INTERACTIVE = 3;
  80.   READYSTATE_COMPLETE = 4;
  81.  
  82. { ShellWindowTypeConstants }
  83.  
  84.   SWC_EXPLORER = 0;
  85.   SWC_BROWSER = 1;
  86.   SWC_3RDPARTY = 2;
  87.   SWC_CALLBACK = 4;
  88.  
  89. { ShellFolderViewOptions }
  90.  
  91.   SFVVO_SHOWALLOBJECTS = 1;
  92.   SFVVO_SHOWEXTENSIONS = 2;
  93.   SFVVO_SHOWCOMPCOLOR = 8;
  94.   SFVVO_SHOWSYSFILES = 32;
  95.   SFVVO_WIN95CLASSIC = 64;
  96.   SFVVO_DOUBLECLICKINWEBVIEW = 128;
  97.   SFVVO_DESKTOPHTML = 512;
  98.  
  99. { ShellSpecialFolderConstants }
  100.  
  101.   ssfDESKTOP = 0;
  102.   ssfPROGRAMS = 2;
  103.   ssfCONTROLS = 3;
  104.   ssfPRINTERS = 4;
  105.   ssfPERSONAL = 5;
  106.   ssfFAVORITES = 6;
  107.   ssfSTARTUP = 7;
  108.   ssfRECENT = 8;
  109.   ssfSENDTO = 9;
  110.   ssfBITBUCKET = 10;
  111.   ssfSTARTMENU = 11;
  112.   ssfDESKTOPDIRECTORY = 16;
  113.   ssfDRIVES = 17;
  114.   ssfNETWORK = 18;
  115.   ssfNETHOOD = 19;
  116.   ssfFONTS = 20;
  117.   ssfTEMPLATES = 21;
  118.  
  119. type
  120.  
  121.   TWebBrowserStatusTextChange = procedure(Sender: TObject; const Text: string) of object;
  122.   TWebBrowserProgressChange = procedure(Sender: TObject; Progress, ProgressMax: Integer) of object;
  123.   TWebBrowserCommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: TOleBool) of object;
  124.   TWebBrowserTitleChange = procedure(Sender: TObject; const Text: string) of object;
  125.   TWebBrowserPropertyChange = procedure(Sender: TObject; const szProperty: string) of object;
  126.   TWebBrowserBeforeNavigate2 = procedure(Sender: TObject; const pDisp: Variant; var URL, Flags, TargetFrameName, PostData, Headers: Variant; var Cancel: TOleBool) of object;
  127.   TWebBrowserNewWindow2 = procedure(Sender: TObject; var ppDisp: Variant; var Cancel: TOleBool) of object;
  128.   TWebBrowserNavigateComplete2 = procedure(Sender: TObject; const pDisp: Variant; var URL: Variant) of object;
  129.   TWebBrowserDocumentComplete = procedure(Sender: TObject; const pDisp: Variant; var URL: Variant) of object;
  130.   TWebBrowserOnVisible = procedure(Sender: TObject; Visible: TOleBool) of object;
  131.   TWebBrowserOnToolBar = procedure(Sender: TObject; ToolBar: TOleBool) of object;
  132.   TWebBrowserOnMenuBar = procedure(Sender: TObject; MenuBar: TOleBool) of object;
  133.   TWebBrowserOnStatusBar = procedure(Sender: TObject; StatusBar: TOleBool) of object;
  134.   TWebBrowserOnFullScreen = procedure(Sender: TObject; FullScreen: TOleBool) of object;
  135.   TWebBrowserOnTheaterMode = procedure(Sender: TObject; TheaterMode: TOleBool) of object;
  136.  
  137.   TWebBrowser = class(TOleControl)
  138.   private
  139.     FOnStatusTextChange: TWebBrowserStatusTextChange;
  140.     FOnProgressChange: TWebBrowserProgressChange;
  141.     FOnCommandStateChange: TWebBrowserCommandStateChange;
  142.     FOnDownloadBegin: TNotifyEvent;
  143.     FOnDownloadComplete: TNotifyEvent;
  144.     FOnTitleChange: TWebBrowserTitleChange;
  145.     FOnPropertyChange: TWebBrowserPropertyChange;
  146.     FOnBeforeNavigate2: TWebBrowserBeforeNavigate2;
  147.     FOnNewWindow2: TWebBrowserNewWindow2;
  148.     FOnNavigateComplete2: TWebBrowserNavigateComplete2;
  149.     FOnDocumentComplete: TWebBrowserDocumentComplete;
  150.     FOnOnQuit: TNotifyEvent;
  151.     FOnOnVisible: TWebBrowserOnVisible;
  152.     FOnOnToolBar: TWebBrowserOnToolBar;
  153.     FOnOnMenuBar: TWebBrowserOnMenuBar;
  154.     FOnOnStatusBar: TWebBrowserOnStatusBar;
  155.     FOnOnFullScreen: TWebBrowserOnFullScreen;
  156.     FOnOnTheaterMode: TWebBrowserOnTheaterMode;
  157.   protected
  158.     procedure InitControlData; override;
  159.   public
  160.     procedure GoBack; stdcall;
  161.     procedure GoForward; stdcall;
  162.     procedure GoHome; stdcall;
  163.     procedure GoSearch; stdcall;
  164.     procedure Navigate(const URL: string; var Flags, TargetFrameName, PostData, Headers: Variant); stdcall;
  165.     procedure Refresh; stdcall;
  166.     procedure Refresh2(var Level: Variant); stdcall;
  167.     procedure Stop; stdcall;
  168.     procedure Quit; stdcall;
  169.     procedure ClientToWindow(var pcx, pcy: Integer); stdcall;
  170.     procedure PutProperty(const Property_: string; const vtValue: Variant); stdcall;
  171.     function GetProperty(const Property_: string): Variant; stdcall;
  172.     procedure Navigate2(var URL, Flags, TargetFrameName, PostData, Headers: Variant); stdcall;
  173.     function QueryStatusWB(cmdID: TOleEnum): TOleEnum; stdcall;
  174.     procedure ExecWB(cmdID, cmdexecopt: TOleEnum; var pvaIn, pvaOut: Variant); stdcall;
  175.     procedure ShowBrowserBar(var pvaClsid, pvarShow, pvarSize: Variant); stdcall;
  176.     property Application: Variant index 200 read GetVariantProp;
  177.     property Parent: Variant index 201 read GetVariantProp;
  178.     property Container: Variant index 202 read GetVariantProp;
  179.     property Document: Variant index 203 read GetVariantProp;
  180.     property TopLevelContainer: TOleBool index 204 read GetOleBoolProp;
  181.     property Type_: string index 205 read GetStringProp;
  182.     property LocationName: string index 210 read GetStringProp;
  183.     property LocationURL: string index 211 read GetStringProp;
  184.     property Busy: TOleBool index 212 read GetOleBoolProp;
  185.     property Name: string index 0 read GetStringProp;
  186.     property HWND: Integer index -515 read GetIntegerProp;
  187.     property FullName: string index 400 read GetStringProp;
  188.     property Path: string index 401 read GetStringProp;
  189.     property ReadyState: TOleEnum index -525 read GetOleEnumProp;
  190.   published
  191.     property TabStop;
  192.     property DragCursor;
  193.     property DragMode;
  194.     property ParentShowHint;
  195.     property PopupMenu;
  196.     property ShowHint;
  197.     property TabOrder;
  198.     property OnDragDrop;
  199.     property OnDragOver;
  200.     property OnEndDrag;
  201.     property OnEnter;
  202.     property OnExit;
  203.     property OnStartDrag;
  204.     property Left: Integer index 206 read GetIntegerProp write SetIntegerProp stored False;
  205.     property Top: Integer index 207 read GetIntegerProp write SetIntegerProp stored False;
  206.     property Width: Integer index 208 read GetIntegerProp write SetIntegerProp stored False;
  207.     property Height: Integer index 209 read GetIntegerProp write SetIntegerProp stored False;
  208.     property Visible: TOleBool index 402 read GetOleBoolProp write SetOleBoolProp stored False;
  209.     property StatusBar: TOleBool index 403 read GetOleBoolProp write SetOleBoolProp stored False;
  210.     property StatusText: string index 404 read GetStringProp write SetStringProp stored False;
  211.     property ToolBar: Integer index 405 read GetIntegerProp write SetIntegerProp stored False;
  212.     property MenuBar: TOleBool index 406 read GetOleBoolProp write SetOleBoolProp stored False;
  213.     property FullScreen: TOleBool index 407 read GetOleBoolProp write SetOleBoolProp stored False;
  214.     property Offline: TOleBool index 550 read GetOleBoolProp write SetOleBoolProp stored False;
  215.     property Silent: TOleBool index 551 read GetOleBoolProp write SetOleBoolProp stored False;
  216.     property RegisterAsBrowser: TOleBool index 552 read GetOleBoolProp write SetOleBoolProp stored False;
  217.     property RegisterAsDropTarget: TOleBool index 553 read GetOleBoolProp write SetOleBoolProp stored False;
  218.     property TheaterMode: TOleBool index 554 read GetOleBoolProp write SetOleBoolProp stored False;
  219.     property AddressBar: TOleBool index 555 read GetOleBoolProp write SetOleBoolProp stored False;
  220.     property Resizable: TOleBool index 556 read GetOleBoolProp write SetOleBoolProp stored False;
  221.     property OnStatusTextChange: TWebBrowserStatusTextChange read FOnStatusTextChange write FOnStatusTextChange;
  222.     property OnProgressChange: TWebBrowserProgressChange read FOnProgressChange write FOnProgressChange;
  223.     property OnCommandStateChange: TWebBrowserCommandStateChange read FOnCommandStateChange write FOnCommandStateChange;
  224.     property OnDownloadBegin: TNotifyEvent read FOnDownloadBegin write FOnDownloadBegin;
  225.     property OnDownloadComplete: TNotifyEvent read FOnDownloadComplete write FOnDownloadComplete;
  226.     property OnTitleChange: TWebBrowserTitleChange read FOnTitleChange write FOnTitleChange;
  227.     property OnPropertyChange: TWebBrowserPropertyChange read FOnPropertyChange write FOnPropertyChange;
  228.     property OnBeforeNavigate2: TWebBrowserBeforeNavigate2 read FOnBeforeNavigate2 write FOnBeforeNavigate2;
  229.     property OnNewWindow2: TWebBrowserNewWindow2 read FOnNewWindow2 write FOnNewWindow2;
  230.     property OnNavigateComplete2: TWebBrowserNavigateComplete2 read FOnNavigateComplete2 write FOnNavigateComplete2;
  231.     property OnDocumentComplete: TWebBrowserDocumentComplete read FOnDocumentComplete write FOnDocumentComplete;
  232.     property OnOnQuit: TNotifyEvent read FOnOnQuit write FOnOnQuit;
  233.     property OnOnVisible: TWebBrowserOnVisible read FOnOnVisible write FOnOnVisible;
  234.     property OnOnToolBar: TWebBrowserOnToolBar read FOnOnToolBar write FOnOnToolBar;
  235.     property OnOnMenuBar: TWebBrowserOnMenuBar read FOnOnMenuBar write FOnOnMenuBar;
  236.     property OnOnStatusBar: TWebBrowserOnStatusBar read FOnOnStatusBar write FOnOnStatusBar;
  237.     property OnOnFullScreen: TWebBrowserOnFullScreen read FOnOnFullScreen write FOnOnFullScreen;
  238.     property OnOnTheaterMode: TWebBrowserOnTheaterMode read FOnOnTheaterMode write FOnOnTheaterMode;
  239.   end;
  240.  
  241.   TShellFolderViewOC = class(TOleControl)
  242.   private
  243.     FOnSelectionChanged: TNotifyEvent;
  244.   protected
  245.     procedure InitControlData; override;
  246.   public
  247.     procedure SetFolderView(const pDisp: Variant); stdcall;
  248.   published
  249.     property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
  250.   end;
  251.  
  252. procedure Register;
  253.  
  254. implementation
  255.  
  256. {$J+}
  257.  
  258. procedure TWebBrowser.InitControlData;
  259. const
  260.   CEventDispIDs: array[0..17] of Integer = (
  261.     $00000066, $0000006C, $00000069, $0000006A, $00000068, $00000071,
  262.     $00000070, $000000FA, $000000FB, $000000FC, $00000103, $000000FD,
  263.     $000000FE, $000000FF, $00000100, $00000101, $00000102, $00000104);
  264.   CControlData: TControlData = (
  265.     ClassID: (
  266.       D1:$8856F961;D2:$340A;D3:$11D0;D4:($A9,$6B,$00,$C0,$4F,$D7,$05,$A2));
  267.     EventIID: (
  268.       D1:$34A715A0;D2:$6587;D3:$11D0;D4:($92,$4A,$00,$20,$AF,$C7,$AC,$4D));
  269.     EventCount: 18;
  270.     EventDispIDs: @CEventDispIDs;
  271.     LicenseKey: nil;
  272.     Flags: $00000000);
  273. begin
  274.   ControlData := @CControlData;
  275. end;
  276.  
  277. procedure TWebBrowser.GoBack;
  278. const
  279.   DispInfo: array[0..7] of Byte = ($64,$00,$00,$00,$00,$01,$00,$00);
  280. begin
  281.   InvokeMethod(DispInfo, nil);
  282. end;
  283.  
  284. procedure TWebBrowser.GoForward;
  285. const
  286.   DispInfo: array[0..7] of Byte = ($65,$00,$00,$00,$00,$01,$00,$00);
  287. begin
  288.   InvokeMethod(DispInfo, nil);
  289. end;
  290.  
  291. procedure TWebBrowser.GoHome;
  292. const
  293.   DispInfo: array[0..7] of Byte = ($66,$00,$00,$00,$00,$01,$00,$00);
  294. begin
  295.   InvokeMethod(DispInfo, nil);
  296. end;
  297.  
  298. procedure TWebBrowser.GoSearch;
  299. const
  300.   DispInfo: array[0..7] of Byte = ($67,$00,$00,$00,$00,$01,$00,$00);
  301. begin
  302.   InvokeMethod(DispInfo, nil);
  303. end;
  304.  
  305. procedure TWebBrowser.Navigate;
  306. const
  307.   DispInfo: array[0..12] of Byte = ($68,$00,$00,$00,$00,$01,$05,$00,$08,$8C,$8C,$8C,$8C);
  308. begin
  309.   InvokeMethod(DispInfo, nil);
  310. end;
  311.  
  312. procedure TWebBrowser.Refresh;
  313. const
  314.   DispInfo: array[0..7] of Byte = ($DA,$FD,$FF,$FF,$00,$01,$00,$00);
  315. begin
  316.   InvokeMethod(DispInfo, nil);
  317. end;
  318.  
  319. procedure TWebBrowser.Refresh2;
  320. const
  321.   DispInfo: array[0..8] of Byte = ($69,$00,$00,$00,$00,$01,$01,$00,$8C);
  322. begin
  323.   InvokeMethod(DispInfo, nil);
  324. end;
  325.  
  326. procedure TWebBrowser.Stop;
  327. const
  328.   DispInfo: array[0..7] of Byte = ($6A,$00,$00,$00,$00,$01,$00,$00);
  329. begin
  330.   InvokeMethod(DispInfo, nil);
  331. end;
  332.  
  333. procedure TWebBrowser.Quit;
  334. const
  335.   DispInfo: array[0..7] of Byte = ($2C,$01,$00,$00,$00,$01,$00,$00);
  336. begin
  337.   InvokeMethod(DispInfo, nil);
  338. end;
  339.  
  340. procedure TWebBrowser.ClientToWindow;
  341. const
  342.   DispInfo: array[0..9] of Byte = ($2D,$01,$00,$00,$00,$01,$02,$00,$83,$83);
  343. begin
  344.   InvokeMethod(DispInfo, nil);
  345. end;
  346.  
  347. procedure TWebBrowser.PutProperty;
  348. const
  349.   DispInfo: array[0..9] of Byte = ($2E,$01,$00,$00,$00,$01,$02,$00,$08,$0C);
  350. begin
  351.   InvokeMethod(DispInfo, nil);
  352. end;
  353.  
  354. function TWebBrowser.GetProperty;
  355. const
  356.   DispInfo: array[0..8] of Byte = ($2F,$01,$00,$00,$0C,$01,$01,$00,$08);
  357. begin
  358.   InvokeMethod(DispInfo, @Result);
  359. end;
  360.  
  361. procedure TWebBrowser.Navigate2;
  362. const
  363.   DispInfo: array[0..12] of Byte = ($F4,$01,$00,$00,$00,$01,$05,$00,$8C,$8C,$8C,$8C,$8C);
  364. begin
  365.   InvokeMethod(DispInfo, nil);
  366. end;
  367.  
  368. function TWebBrowser.QueryStatusWB;
  369. const
  370.   DispInfo: array[0..8] of Byte = ($F5,$01,$00,$00,$02,$01,$01,$00,$02);
  371. begin
  372.   InvokeMethod(DispInfo, @Result);
  373. end;
  374.  
  375. procedure TWebBrowser.ExecWB;
  376. const
  377.   DispInfo: array[0..11] of Byte = ($F6,$01,$00,$00,$00,$01,$04,$00,$02,$02,$8C,$8C);
  378. begin
  379.   InvokeMethod(DispInfo, nil);
  380. end;
  381.  
  382. procedure TWebBrowser.ShowBrowserBar;
  383. const
  384.   DispInfo: array[0..10] of Byte = ($F7,$01,$00,$00,$00,$01,$03,$00,$8C,$8C,$8C);
  385. begin
  386.   InvokeMethod(DispInfo, nil);
  387. end;
  388.  
  389. procedure TShellFolderViewOC.InitControlData;
  390. const
  391.   CEventDispIDs: array[0..0] of Integer = (
  392.     $000000C8);
  393.   CControlData: TControlData = (
  394.     ClassID: (
  395.       D1:$9BA05971;D2:$F6A8;D3:$11CF;D4:($A4,$42,$00,$A0,$C9,$0A,$8F,$39));
  396.     EventIID: (
  397.       D1:$62112AA2;D2:$EBE4;D3:$11CF;D4:($A5,$FB,$00,$20,$AF,$E7,$29,$2D));
  398.     EventCount: 1;
  399.     EventDispIDs: @CEventDispIDs;
  400.     LicenseKey: nil;
  401.     Flags: $00000000);
  402. begin
  403.   ControlData := @CControlData;
  404. end;
  405.  
  406. procedure TShellFolderViewOC.SetFolderView;
  407. const
  408.   DispInfo: array[0..8] of Byte = ($00,$00,$02,$60,$00,$01,$01,$00,$0C);
  409. begin
  410.   InvokeMethod(DispInfo, nil);
  411. end;
  412.  
  413. procedure Register;
  414. begin
  415.   RegisterComponents('OCX', [TWebBrowser, TShellFolderViewOC]);
  416. end;
  417.  
  418. end.
  419.